(* classe managing a map *)
(* made using Ocaml-SDL *)
(* created by Sweepy *)
(* added to Subversion server *)


(* int ref > used as an accumulator to get a color height *)
let colorToFind = ref 0

(* int > increase the size of the 3D modelisation *)
let coefficient = 20

(******** functions used by classes ********)

(* return whether two colors are equals or not *)
let areDifferents (r1,g1,b1,r2,g2,b2) imageCorrectionArtefacts =
			let color1 = (r1+g1+b1)/3 and
			color2 = (r2+g2+b2)/3 in
			begin
			if (abs(color1 - color2) < imageCorrectionArtefacts) then
				(true)
			else
				(false)
			end


(* > delete elements that appear more than once *)
let f res e = if List.mem e res then res else e::res

let deleteDoublons l = List.fold_left f [] l


(* absolute value of an integer *)
let absoluteV a = if (a < 0) then -a else a


(* return the height of a color *)
let findAltitude element =
	let (x,y) = element in
		if (x == !colorToFind) then
			(true)
		else
			(false)


(******** class - manage height and colors ********)

(* display found colors in the interface *)
class displayColor (color_init:(int*int*int)) =
	object (self)
		val mutable color = color_init
		method get_color = color
		val mutable hBox = GPack.hbox
		val mutable frameColor = GButton.button ~label:"colored frame" ()
		val mutable frameEntry = GButton.button ~label:"text entry" ()
	end;;


(******** class - manage a 2D map until its 3D modelisation ********)
class mapPlan (imagePath_init:string) =
	object (self)
		(* chemin de l'image *)
		val mutable imagePath = imagePath_init
		method get_imagePath = imagePath
		method set_imagePath newImagePath = imagePath <- newImagePath
		val mutable altitudesPath = 0::[]
		method emptyAltitudesPath = altitudesPath <- 0::[]
		method addPointAltitudesPath x = altitudesPath <- x::(altitudesPath)
		val mutable imageWidth = 0
		val mutable imageHeight = 0
		method get_imageWidth = imageWidth
		method get_imageHeight = imageHeight
		method set_imageSize =
			let surface = Sdlloader.load_image imagePath in
				begin
				imageWidth <-
				(Sdlvideo.surface_info surface).Sdlvideo.w;
				imageHeight <-
				(Sdlvideo.surface_info surface).Sdlvideo.h;
				end
		method get_imageMax =
			if (imageWidth < imageHeight) then
				(imageWidth)
			else
				(imageHeight)


		val mutable listColors = []
		val mutable listDisplayColors = []
		method addColor x = listColors <- (x :: listColors)
		method get_listColors = listColors
		method get_listDisplayColors = listDisplayColors

		val mutable listColorsRGB  = (3,4)::[]
		method get_listColorsRGB = listColorsRGB
		method set_listColorsRGB x = listColorsRGB <- x
		method empty_listColorsRGB = listColorsRGB <- []


		(* A* algorithm *)
		val mutable departureIti = (10,10)
		val mutable arrivalIti = (10,10)
		method set_departureIti x = departureIti <- x
		method set_arrivalIti x = arrivalIti <- x
		method draw_iti =
			let (x1,y1) = departureIti and (x2,y2) = arrivalIti in
			let surface = Sdlloader.load_image imagePath in
			for i = -1 to 1 do
				for j = -1 to 1 do
				Sdlvideo.put_pixel_color
					surface
					~x:(x1 + i)
					~y:(y1 + j)
					(255,0,0);
				Sdlvideo.put_pixel_color
					surface
					~x:(x2 + i)
					~y:(y2 + j)
					(255,0,0);
				done;
			done;

			let decalageDepartureX = if (x1 > (imageWidth - 70))
				then -70 else 10
			and decalageDepartureY = if (y1 > (imageHeight - 20))
				then -20 else 10 in
			let font = Sdlttf.open_font "pixel.TTF" 10 in
			let textAccueil =
				Sdlttf.render_text_blended font "Depart"
				~fg:Sdlvideo.red in
				Sdlvideo.blit_surface
				~dst_rect:(Sdlvideo.rect
				(x1 + decalageDepartureX)
				(y1 + decalageDepartureY)
				300
				50)
				~src:textAccueil
				~dst:surface ();


			let decalageArrivalX = if (x2 > (imageWidth - 70))
						then -70 else 10
			and decalageArrivalY = if (y2 > (imageHeight - 20))
						then -20 else 10 in
			let font2 = Sdlttf.open_font "pixel.TTF" 10 in
			let textAccueil2  =
				Sdlttf.render_text_blended font2 "Arrivee"
				~fg:Sdlvideo.red in
			Sdlvideo.blit_surface
				~dst_rect:(Sdlvideo.rect
				(x2 + decalageArrivalX)
				(y2 + decalageArrivalY)
				300
				50)
				~src:textAccueil2
				~dst:surface  ();

			Sdlvideo.save_BMP surface (imagePath ^ "itineraire.bmp")


		method process_path =
			self#emptyAltitudesPath;
			let (x0,y0) = departureIti
			and (x1,y1) = arrivalIti in
			let surface = Sdlloader.load_image imagePath in
				let steep = abs(y1 - y0) > abs(x1 - x0) in

				let plot =
					if steep
					then (fun x y -> Sdlvideo.put_pixel_color
					surface
					~x:(y)
					~y:(x)
					(255,0,0))
					else (fun x y -> Sdlvideo.put_pixel_color
					surface
					~x:(x)
					~y:(y)
					(255,0,0))
				in
				let x0, y0, x1, y1 =
					if steep
					then y0, x0, y1, x1
					else x0, y0, x1, y1
				in
				let x0, x1, y0, y1 =
					if x0 > x1
					then x1, x0, y1, y0
					else x0, x1, y0, y1
				in
				let delta_x = x1 - x0
					and delta_y = abs(y1 - y0) in
					let error = -delta_x / 2
					and y_step =
				if y0 < y1 then 1 else -1
				in
					let rec loop x y error =
					let altitudePoint =
					let (r1,g1,b1) =
						Sdlvideo.get_pixel_color
						surface
						~x:(x)
						~y:(y) in
							colorToFind := (r1+g1+b1)/3;
				let (_,z) =
				(List.find findAltitude listColorsRGB) in
				self#addPointAltitudesPath (z);
					Sdlvideo.put_pixel_color surface
					~x:(x)
					~y:(y)
					(255,0,0) in
					if x <= x1 then
					let error = error + delta_y in
					let y, error =
					if error > 0
					then (y + y_step), (error - delta_x)
					else y, error
					in
					loop (succ x) y error
					in
					loop x0 y0 error;
			let decalageDepartureX =
				if (x0 > (imageWidth - 70)) then -70 else 10
			and decalageDepartureY =
				if (y0 > (imageHeight - 20)) then -20 else 10 in
			let font = Sdlttf.open_font "pixel.TTF" 10 in
			let textAccueil =
				Sdlttf.render_text_blended font "Depart"
				~fg:Sdlvideo.red in
			Sdlvideo.blit_surface
				~dst_rect:(Sdlvideo.rect
				(x0 + decalageDepartureX)
				(y0 + decalageDepartureY)
				300
				50)
				~src:textAccueil
				~dst:surface  ();

			let decalageArrivalX = if (x1 > (imageWidth - 70))
						then -70 else 10
			and decalageArrivalY = if (y1 > (imageHeight - 20))
						then -20 else 10 in
			let font2 = Sdlttf.open_font "pixel.TTF" 10 in
			let textAccueil2  =
				Sdlttf.render_text_blended font2 "Arrivee"
				~fg:Sdlvideo.red in
			Sdlvideo.blit_surface
				~dst_rect:(Sdlvideo.rect
				(x1 + decalageArrivalX)
				(y1 + decalageArrivalY)
				300
				50)
				~src:textAccueil2
				~dst:surface  ();

			Sdlvideo.save_BMP surface
				(imagePath ^ "itineraireDone.bmp")



		val mutable upDenivelate = 0
		val mutable downDenivelate = 0
		val mutable finalDenivelate = 0
		val mutable averageTime = 0


		(* .OBJ *)
		val mutable listFaces = ""::[]
		val mutable listPoints = ""::[]
		val mutable listTextures = ""::[]
		val mutable compteur = 1

		val mutable imageMaillageSize = 1
		val mutable imageCorrectionArtefacts = 1
		val mutable imageWantToChangeColors = false
		val mutable imageWantToCreateLogFile = false
		val mutable imageWantToAddObliques = true
		val mutable imageOpacityLines = 100
		val mutable traitementColor = true
		val mutable minAltitude = 0
		val mutable maxAltitude = 0


		method set_imageMaillageSize x = imageMaillageSize <- x
		method set_imageCorrectionArtefacts x =
			imageCorrectionArtefacts <- x;
		method set_imageWantToChangeColors x =
					imageWantToChangeColors <- x
		method set_imageWantToCreateLogFile x =
					imageWantToCreateLogFile <- x
		method set_imageWantToAddObliques x =
					imageWantToAddObliques <- x
		method set_imageOpacityLines x = imageOpacityLines <- x
		method set_traitementColor x = traitementColor <- x
		method set_minAltitude x =
			minAltitude <- x
		method set_maxAltitude x =
			maxAltitude <- x



(* method used to draw the height map obj *)



		val mutable coefficient = 5


		method createHeightObj () =
			Sdl.init [`EVERYTHING];


			let oc = open_out (imagePath ^ "modelisationHeight.obj") in
			let img = Sdlloader.load_image (imagePath ^ "mapped.bmp") in
			let (w,h) = ((Sdlvideo.surface_info img).Sdlvideo.w,
			(Sdlvideo.surface_info img).Sdlvideo.h)
			in
			begin

			let i = ref 0
			and j = ref 0
			in
			(* ajout des points *)
			while !i <= (h - 0 - imageMaillageSize) do
			j := 0;
			while !j <= (w- 0 - imageMaillageSize) do
			begin
				let (r1,g1,b1) =
				Sdlvideo.get_pixel_color img !j !i in
				let height1 =
				int_of_float(((float)(r1) /. 255.) *.
				(float)(absoluteV (maxAltitude - minAltitude))) in
				let point1 =
				"v " ^ string_of_int(!j * coefficient) ^ " " ^
				string_of_int(!i * coefficient) ^ " " ^
				string_of_int(height1)
				in listPoints <- point1::listPoints;
					output_string oc (point1 ^ "\n");
				j := !j + imageMaillageSize
			end
			done;
			i := !i + imageMaillageSize
			done;


			let w1 = (w/imageMaillageSize)
			and h1 = (h/imageMaillageSize)
			in
			(* ajout des faces *)
			for i = 0 to (w1 - 3) do
			for j = 0 to (h1 - 3) do
				let face1 =
				"f " ^ string_of_int(j * w1 + i + 1) ^ " " ^
				string_of_int(j * w1 + i + 2) ^ " " ^
				string_of_int((j + 1) * w1 + i + 2)
				and face2 =
				"f " ^ string_of_int(j * w1 + i + 1) ^ " " ^
				string_of_int((j + 1) * w1 + i + 2) ^ " " ^
				string_of_int((j + 1) * w1 + i + 1)
				in
					output_string oc (face1 ^ "\n");
				output_string oc (face2 ^ "\n");
				(*print_endline (face1);
				print_endline (face2)*)
			done;
			done;
			close_out oc;
			end



		method blurImage src radius =
			let dst = src
			and total = ref 0 in
			for y = radius to (imageHeight - 1 - radius) do
			for x = radius to (imageWidth - 1 - radius) do
				total := 0;
				for ky = -radius to radius do
				for kx = -radius to radius do
					let (r,_,_) = Sdlvideo.get_pixel_color
					src (x+kx) (y+ky) in
					total := !total + r
				done;
				done;
				let totalFinal =
				(!total / ((radius * 2 + 1) * (radius * 2 + 1)))
				in
				Sdlvideo.put_pixel_color
				dst
				x
				y
				(totalFinal, totalFinal, totalFinal)
			done;
			done;
			(dst)


		method transformHeightMap =
			Sdl.init [`VIDEO];
			let image = imagePath in
			let surface = Sdlloader.load_image image in
			let surface_tmp = surface
			in

			for i = 0 to  (imageWidth - 1) do
				for j = 0 to (imageHeight - 1) do
				begin
				let (r,g,b) = Sdlvideo.get_pixel_color
					surface_tmp
					(i)
					(j)
				in Sdlvideo.put_pixel_color
					surface
					(i)
					(j)
					((r+g+b)/3, (r+g+b)/3, (r+g+b)/3)
				end
				done
			done;

			surface = (self#blurImage surface 5);

			Sdlvideo.save_BMP surface (imagePath ^ "mapped.bmp")


		method transformPlanMap =
			Sdl.init [`VIDEO];
			let image = imagePath in
			let surface = Sdlloader.load_image image in
			let surface_tmp = surface in
			Sdlvideo.save_BMP surface (imagePath ^ "mapped.bmp");

			(* dessin des contours verticaux *)
			let i = ref 0 and j = ref 0 in
			begin
			while (!i < imageWidth - 2) do
				begin
				j := 0;
				while (!j < imageHeight - 2) do
				    let (r1,g1,b1) =
					Sdlvideo.get_pixel_color
					    surface_tmp
					    ~x:(!i)
					    ~y:(!j) and
				    (r2,g2,b2) =
					Sdlvideo.get_pixel_color
					surface_tmp
					~x:(!i)
					~y:(!j + 1) in

				    begin
				    if (r1 != r2 && g1 != g2 && b1 != b2) then
				    	begin
					Sdlvideo.put_pixel_color
					    surface
					    ~x:(!i)
					    ~y:(!j)
					    (0,0,0);
					Sdlvideo.put_pixel_color
					    surface
					    ~x:(!i)
					    ~y:(!j + 1)
					    (0,0,0);
					j := !j + 2;
					end
				    else
					j := !j + 1
				    end
				done;
				i := !i + 1
				end
			done;
			end;



			(* dessin des contours horizontaux *)
			let i = ref 0 and j = ref 0 in
			begin
			let (r,g,b) = Sdlvideo.get_pixel_color
			    surface_tmp
			    ~x:(!i)
			    ~y:(!j)
			in self#addColor (r,g,b);

			while (!j < imageHeight - 2) do
				begin
				i := 0;
				while (!i < imageWidth - 2) do
					let (r1,g1,b1) =
					    Sdlvideo.get_pixel_color
						surface_tmp
						~x:(!i)
						~y:(!j) and
					(r2,g2,b2) = Sdlvideo.get_pixel_color
						surface_tmp
						~x:(!i + 1)
						~y:(!j) in
					begin


					if ((areDifferents
					    (r1,g1,b1,r2,g2,b2)
					    imageCorrectionArtefacts) == false)
					    then
						begin
						Sdlvideo.put_pixel_color
						    surface
						    ~x:(!i)
						    ~y:(!j)
						    (0,0,0);
						Sdlvideo.put_pixel_color
						    surface
						    ~x:(!i + 1)
						    ~y:(!j)
						    (0,0,0);
						i := !i + 2;
						

						self#addColor (r2,g2,b2);
						end
					else
						i := !i + 1
					end


				done;
				j := !j + 1
				end
			done;
			end;

			for i = 0 to (imageWidth - 1) do
				for j = 0 to
				    (imageHeight / imageMaillageSize - 1) do
					Sdlvideo.put_pixel_color
					    surface
					    ~x:(i)
					    ~y:(j * imageMaillageSize)
					    (0,0,0);

				done;

			done;
			for i = 0 to (imageWidth / imageMaillageSize - 1) do
				for j = 0 to (imageHeight - 1) do
					Sdlvideo.put_pixel_color
					    surface
					    ~x:(i * imageMaillageSize)
					    ~y:(j)
					    (0,0,0);

				done;

			done;


			if (imageWantToAddObliques == true) then
			begin

				for i = 0 to (imageHeight - 1) do
				    for j = 0 to
				        (imageWidth / imageMaillageSize - 1) do
					    Sdlvideo.put_pixel_color
						surface
						~x:(j * imageMaillageSize + i)
						~y:(i) (0,0,0);

					done;
				done;
			end;
			
			listColors <- deleteDoublons (listColors);

			Sdlvideo.save_BMP surface (imagePath ^ "mapped.bmp");
			
			
			let rec matching l2 = match l2 with
				| x::l2 -> begin
					let newDisplayColors =
					    new displayColor x in
		    		listDisplayColors <-
			    	    (newDisplayColors::listDisplayColors);
					matching l2;
					end
				| _ -> ()
			in matching listColors;


			Sdl.quit ()



	(* génère le fichier .OBJ d'après les listes de faces et de points *)
	method generateObjFile () =
		let oc = open_out (imagePath ^ "modelisationColor.obj") in
		begin

		List.iter (output_string oc)
		    (List.map (function x -> (x ^ "\n")) listPoints);

		(output_string oc) "\n\n"; 

		List.iter (output_string oc)
		    (List.map (function x -> (x ^ "\n")) listFaces);



		(output_string oc) "\n\n";

		List.iter (output_string oc)
		    (List.map (function x -> (x ^ "\n")) listTextures);


		close_out oc;

		end



	(* création du .OBJ *)
	method create_obj () =
		let i = ref 0 and j = ref 0 in
			begin
			let rec matching l = match l with
				| x::l -> matching l;
				| _ -> ()
			in matching listColorsRGB;

			let surface = Sdlloader.load_image imagePath in

			while (!i < imageWidth - imageMaillageSize) do
				begin
				j := 0;
				while (!j < imageHeight - imageMaillageSize) do

					let (r1,g1,b1) =
					    Sdlvideo.get_pixel_color
						surface
						~x:(!i)
						~y:(!j) in
						colorToFind := (r1+g1+b1)/3;

					let (_,z) = (List.find
					    findAltitude listColorsRGB) in
		listPoints <- ("v " ^ string_of_int(!i * coefficient) ^ " "
		^ string_of_int(!j * coefficient) ^ " "
		^ (string_of_int (z * 100)))::listPoints;

		listTextures <- ("vt " ^
		string_of_float(float_of_int(!i) /. (float)(imageWidth)) ^ " " ^
    string_of_float(float_of_int(!j) /. (float)(imageHeight)))::listTextures;

				    let (r2,g2,b2) = Sdlvideo.get_pixel_color
					    surface
					    ~x:(!i + imageMaillageSize)
					    ~y:(!j) in
						colorToFind := (r2+g2+b2)/3;

				    let (_,z) =
				    (List.find findAltitude listColorsRGB) in
		listPoints <- ("v " ^
		string_of_int((!i + imageMaillageSize) * coefficient) ^ " " ^
		string_of_int(!j * coefficient) ^ " " ^
		(string_of_int (z * 100)))::listPoints;


		listTextures <- ("vt " ^
		string_of_float(float_of_int(!i + imageMaillageSize) /.
		(float)(imageWidth)) ^ " " ^
		string_of_float(float_of_int(!j) /.
		(float)(imageHeight)))::listTextures;

		let (r3,g3,b3) = Sdlvideo.get_pixel_color
		    surface
		    ~x:(!i + imageMaillageSize)
		    ~y:(!j + imageMaillageSize) in
			colorToFind := (r3+g3+b3)/3;

		let (_,z) = (List.find findAltitude listColorsRGB) in
		    listPoints <- ("v " ^
			string_of_int((!i + imageMaillageSize) * coefficient)
			^ " " ^ string_of_int((!j + imageMaillageSize) *
			coefficient) ^ " " ^
			(string_of_int (z * 100)))::listPoints;


		listTextures <- ("vt " ^
		string_of_float(float_of_int(!i + imageMaillageSize) /.
		(float)(imageWidth)) ^ " " ^
		string_of_float(float_of_int(!j + imageMaillageSize) /.
		(float)(imageHeight)))::listTextures;

		let (r4,g4,b4) = Sdlvideo.get_pixel_color
		    surface
		    ~x:(!i)
		    ~y:(!j + imageMaillageSize) in
		colorToFind := (r4+g4+b4)/3;

		let (_,z) = (List.find findAltitude listColorsRGB) in
		listPoints <- ("v " ^ string_of_int(!i * coefficient) ^
		" " ^ string_of_int((!j + imageMaillageSize) * coefficient) ^
		" " ^ string_of_int (z * 100))::listPoints;


		listTextures <- ("vt " ^ string_of_float(float_of_int(!i) /.
		(float)(imageWidth)) ^ " " ^
		string_of_float(float_of_int(!j + imageMaillageSize) /.
		(float)(imageHeight)))::listTextures;

		listFaces <- ("f " ^ (string_of_int compteur) ^ " "
		^ (string_of_int (compteur + 1)) ^ " "
		^ (string_of_int (compteur + 2)))::listFaces;
		listFaces <- ("f " ^ (string_of_int compteur) ^
		" " ^ (string_of_int (compteur + 2) ^
		" " ^ (string_of_int (compteur + 3))))::listFaces;

					compteur <- compteur + 4;

					j := !j + imageMaillageSize
				done;
				i := !i + imageMaillageSize
				end
			done;

			self#generateObjFile ();

			end


	end;;
